;;; firemacs-render.el --- 

;; Copyright 2006 Lukas Loehrer
;;
;; Author: = loehrerl [at] gmx [dot] net
;; Version: $Id: firemacs-render-test.el,v 0.0 2006/11/24 14:23:22 luke Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'firemacs-render-test)

;;; Code:

(provide 'firemacs-render)
(eval-when-compile
  (require 'cl))

;;{{{ Helper functions

(defsubst firemacs-render-children (node context)
  (dolist (child-node (mozremote-dictionary-get 'cn node))
	(firemacs-render-node child-node context)))

(defsubst firemacs-render-bol-p ()
  "Retrun t if point is at bol or there is only margin on the current line before point."
  (or (bolp) (not
			 (text-property-not-all (line-beginning-position) (point) 'firemacs-margin t))))

(defsubst firemacs-render-ensure-bol ()
  "Make sure point is at the beginning of a blank line."
  (unless (firemacs-render-bol-p)
	(insert "\n")))

(defun firemacs-render-ensure-after-blank-line ()
  (unless (or (bobp) (and
			  (bolp)
			  (save-excursion
				(forward-line -1)
				(and (bolp) (eolp)))))
	(insert "\n")
	(firemacs-render-ensure-after-blank-line)))

(defun add-to-text-property (pos prop item &optional prepend object)
  (let ((items (get-text-property pos prop object)))
	(cond
	 (prepend
	  (setq items (cons item items)))
	 (t
	  (push item items)))
	(put-text-property pos (+ pos 1) prop items object)))

(defsubst firemacs-render-append-ems-action  (action &optional pos)
  "Append ACTION to fm-ems-actions text property at  POS."
  (unless pos
	(setq pos (point)))
  (add-to-text-property pos 'fm-ems-actions action))

(defsubst firemacs-render-prepend-ems-action  (action &optional pos)
  "Prepend ACTION to fm-ems-actions text property at  POS."
  (unless pos
	(setq pos (point)))
  (add-to-text-property pos 'fm-ems-actions action t))


;;}}}

(defvar firemacs-render-block-type-elements
  '(BODY DIV TABLE UL OL DT)
  "List of element names that are considered block type elements by the renderer.")

(defvar firemacs-render-inline-type-elements
  '(SPAN B I STRING)
  "List of inline type elements.")


(defun firemacs-render-inline-type-element (node context)
  (firemacs-render-children node context))

(defun firemacs-render-block-type-element (node context)
  "make sure we start on a new line and end on one"
  (firemacs-render-ensure-bol)
  (firemacs-render-children node context)
  (firemacs-render-ensure-bol))
							  


;;{{{Emacspeak actions


(defun fm-ems-link-action (pos)
  ;; TODO: differentiate between internal and external links, ftp, e-mail etc
  (dtk-speak "link"))

(defun fm-ems-heading-action (pos)
  (let ((level (get-text-property pos 'fm-heading-level)))
	(dtk-speak (format "heading level %d" level))))


(defun fm-ems-control-action ()
  (let* ((control (get-text-property (point) 'fm-control))
		(type (get-text-property (point) 'fm-control-type))
		(state (mozremote-object-call-method-sync firemacs-remote-browser "getFormControlState" control)))
	(dtk-speak (format "%s %s" type state))))

;;}}}

;;{{{Render functions for different HTML elements

(defun firemacs-render-image (node context)
  "Render image node."
  (let ((desc (mozremote-dictionary-get 'desc node)))
	(insert (format "Image: %s" desc))))

(defun firemacs-render-list (node context)
  "Render UL and OL."
  (firemacs-render-ensure-bol)
  (let ((child-nodes (mozremote-dictionary-get 'cn node))
		(start (point)))
	(insert (format "List with %d itens." (length child-nodes)))
	(firemacs-render-ensure-bol)
	(firemacs-render-children node context)
	(firemacs-render-ensure-bol)
	(insert "List end.")
	(firemacs-render-ensure-bol)))

(defun firemacs-render-table (node context)
  "Start block
Write table label (Table with x rows and y columns
Render contents
end block"
  (firemacs-render-ensure-bol)
  (let ((start (point)))
	(insert "Begin table.")
	(firemacs-render-ensure-bol)
	(firemacs-render-children node context)
	(firemacs-render-ensure-bol)
	(insert "Table end.")
	(firemacs-render-ensure-bol)))

(defun firemacs-render-anchor (node context)
  "Render an HTML anchor element."
  (let ((href (mozremote-dictionary-get 'href node))
		(name (mozremote-dictionary-get 'name node)))
	;; Check if we have an anchor
	(when name
	  ;; TODO: somehow remember anchor position
	  )
	;; Check if we have a link
	(when href
	  (firemacs-render-ensure-bol)
	  (let ((start (point))
			(link-object (mozremote-dictionary-get 'node node)))
		;; TODO make context reflect we are in a link
		(firemacs-render-children node context)
		(add-text-properties start (point) (
											list 'fm-link link-object
												 'fm-default-action 'firemacs-link-action))
		(firemacs-render-prepend-ems-action 'fm-ems-link-action start)
		(firemacs-render-ensure-bol)))))
  
(defun firemacs-render-heading (node context)
  "Make sure we are on a blank line
set heading data in context (level)
render contents
make sure we start on a blank line."
  (firemacs-render-ensure-bol)
  (let ((level (mozremote-dictionary-get 'level node))
		(start (point)))
	(firemacs-render-children node context)
	(add-text-properties start (point)
						 `(fm-heading 42
									  fm-heading-level ,level))
	(firemacs-render-append-ems-action 'fm-ems-heading-action start)
	(firemacs-render-ensure-after-blank-line)))

(defun firemacs-render-list-item (node)
  "Make sure we are on a new line
Get type of list from context
Render Number or bullet
render content")

(defun firemacs-render-paragraph (node context)
  "Render paragraph node.

Paragraphs are separated by a blank line from the preceeding text."
  (firemacs-render-ensure-after-blank-line)
  (firemacs-render-children node context))
;;}}}

(defun firemacs-render-document(node context)
  "Render document node into current buffer."
  (firemacs-render-ensure-bol)
  (insert (mozremote-dictionary-get 'title node))
  (firemacs-render-ensure-after-blank-line)
  (firemacs-render-children node context))

(defun firemacs-render-text (node context)
  "Write the text in NODE into the current buffer with text properties set according to CONTEXT."
  (let ((text (mozremote-dictionary-get 'text node))
		(leaf (mozremote-dictionary-get 'node node))
		(start (point)))
	(insert text)
	(add-text-properties start (point)  (list 'fm-leaf leaf))
	(fill-region start (point))))


(defun firemacs-render-control (node)
  "Render form control."
  (firemacs-render-ensure-bol)
  (let ((type (mozremote-dictionary-get 'type node))
		(text (mozremote-dictionary-get 'text node))
		(control (mozremote-dictionary-get 'control node))
		(start (point)))
	(insert display-text)
	(add-text-properties start (point)
						 `(fm-default-action ,(intern (concat "fm-" type "-control-action"))
											 fm-control ,control
											 fm-control-type ,type))
	(add-text-properties start (+ start 1) '(emacspeak-action fm-ems-control-action))
	(firemacs-render-ensure-bol)))
						 
						 

(defun firemacs-render-node (node context)
  "Render NODE into firemacs buffer.

Performs dispatch for different element types."
  (let ((type (intern (mozremote-dictionary-get 'type node))))
	(unless type
	  (setq fm-debug node))
	(case type
	  ('text
	   (firemacs-render-text node context))
	  ((P HR)
	   (firemacs-render-paragraph node context))
	  ('H
	   (firemacs-render-heading node context))
	  ('A
	   (firemacs-render-anchor node context))
	  ('IMG
	   (firemacs-render-image node context))
	  ((UL OL)
	   (firemacs-render-list node context))
	  (TABLE
	   (firemacs-render-table node context))
	  ('document
	   (firemacs-render-document node context))
	  ((DIV FORM)
	   (firemacs-render-block-type-element node context))
	  ((button entry checkbox radio-button select textarea)
	   (firemacs-render-control node))
	  (otherwise
	   (firemacs-render-inline-type-element node context)))))



;;{{{  emacs local variables

;;; local variables:
;;; folded-file: t
;;; byte-compile-dynamic: t
;;; end:

;;}}}

;;; firemacs-render.el ends here
